Unlike K-means algorithm, each data object is not the member of only one cluster but is the member of all clusters with varying degrees of memberhip between 0 and 1.

In our case , each data object belong to ONLY one cellular component nuclear, cytoplasm or membrane.

Conclusion: 1 - fcm and pfcm takes a lot of time if we use high image resolution 2 - k-means method seems to be more suitable.

im <- readImage("basales.jpg")
dim(im)
[1] 1024  768    3
plot(im) # raster method means within R

##  I. reduce the size of image 
# scale to a specific width and height
   #ims <- resize(im, w = 200, h = 100)
# II. scale by 50%; the height is determined automatically so that
# the aspect ratio is preserved
ims <- resize(im, dim(im)[1]/8)
ims
Image 
  colorMode    : Color 
  storage.mode : double 
  dim          : 128 96 3 
  frames.total : 3 
  frames.render: 1 

imageData(object)[1:5,1:6,1]
          [,1]      [,2]      [,3]      [,4]      [,5]      [,6]
[1,] 0.8235294 0.8225490 0.8127451 0.7823529 0.7833333 0.7980392
[2,] 0.8137255 0.7970588 0.7843137 0.7656863 0.7156863 0.7882353
[3,] 0.8196078 0.7460784 0.7833333 0.7725490 0.8196078 0.8343137
[4,] 0.7872549 0.8362745 0.8764706 0.8313725 0.8843137 0.8382353
[5,] 0.7921569 0.8725490 0.8980392 0.8500000 0.8784314 0.8774510
plot(ims)

# reshape image into a data frame
df = data.frame(
  red = matrix(ims[,,1], ncol=1),
  green = matrix(ims[,,2], ncol=1),
  blue = matrix(ims[,,3], ncol=1)
)
str(df)
'data.frame':   12288 obs. of  3 variables:
 $ red  : num  0.824 0.814 0.82 0.787 0.792 ...
 $ green: num  0.801 0.785 0.768 0.725 0.696 ...
 $ blue : num  0.788 0.799 0.775 0.773 0.759 ...

Unsupervised Possibilistic Fuzzy C-Means algorithm

## this run takes a lot of time even I reduce the size of image by 4
res.pfcm <- ppclust::pfcm(df, centers=5)
# a numeric matrix containing the typicality degrees of the data objects.
# head(res.pfcm$t)
#   Cluster 1  Cluster 2 Cluster 3  Cluster 4  Cluster 5
# 1 0.1288446 0.02401000 0.5443269 0.04291962 0.02055977
# 2 0.1372704 0.02475138 0.5163443 0.04446920 0.02134524
# 3 0.1778028 0.02888067 0.6170897 0.05291714 0.02388038
# 4 0.2379715 0.03496650 0.3370548 0.06518729 0.02919441
# 5 0.3363520 0.04244848 0.2810300 0.08164521 0.03373603
# 6 0.2753612 0.04541603 0.1528285 0.08426691 0.03965113
# a numeric matrix containing the distances of objects to the final cluster proto- types
# head(res.pfcm$d)
#  Cluster 1  Cluster 2   Cluster 3  Cluster 4 Cluster 5
# 1 0.04158602 0.14948141 0.003761511 0.11366701 0.2243028
# 2 0.03865589 0.14489382 0.004208872 0.10952852 0.2158755
# 3 0.02844168 0.12365149 0.002788159 0.09122913 0.1924584
# 4 0.01969538 0.10149022 0.008837837 0.07309768 0.1565697
# 5 0.01213561 0.08295336 0.011495473 0.05733525 0.1348580
# 6 0.01618590 0.07729278 0.024907817 0.05539285 0.1140377
# a numeric vector containing the cluster labels found by defuzzifying the typicality degrees of the objects.
res.pfcm$cluster[1:20]
# 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 
# 3  3  3  3  1  1  1  1  3  1  1  4  4  4  4  4  2  2  5  5 
#unique(res.pfcm$cluster)
#[1] 3 1 4 2 5
# a numeric vector for the number of objects in the clusters.
# res.pfcm$csize
#   1    2    3    4    5 
# 2892 2028 2610 2174 2584

Partitioning Cluster Analysis Using Fuzzy C-Means

im <- readImage("basales.jpg")
dim(im)
[1] 1024  768    3
# II. scale by 50%; the height is determined automatically so that
# the aspect ratio is preserved
ims <- resize(im, dim(im)[1]/8)
plot(ims)

# reshape image into a data frame
df = data.frame(
  red = matrix(ims[,,1], ncol=1),
  green = matrix(ims[,,2], ncol=1),
  blue = matrix(ims[,,3], ncol=1)
)
str(res.fcm)
List of 17
 $ u         : num [1:12288, 1:5] 0.126 0.173 0.234 0.541 0.726 ...
  ..- attr(*, "dimnames")=List of 2
  .. ..$ : chr [1:12288] "1" "2" "3" "4" ...
  .. ..$ : chr [1:5] "Cluster 1" "Cluster 2" "Cluster 3" "Cluster 4" ...
 $ v         : num [1:5, 1:3] 0.837 0.879 0.677 0.818 0.839 ...
  ..- attr(*, "dimnames")=List of 2
  .. ..$ : chr [1:5] "Cluster 1" "Cluster 2" "Cluster 3" "Cluster 4" ...
  .. ..$ : chr [1:3] "red" "green" "blue"
 $ v0        : num [1:5, 1:3] 0.719 0.908 0.72 0.839 0.776 ...
  ..- attr(*, "dimnames")=List of 2
  .. ..$ : chr [1:5] "Cluster 1" "Cluster 2" "Cluster 3" "Cluster 4" ...
  .. ..$ : chr [1:3] "red" "green" "blue"
 $ d         : num [1:12288, 1:5] 0.02124 0.01897 0.0122 0.00741 0.00357 ...
  ..- attr(*, "dimnames")=List of 2
  .. ..$ : chr [1:12288] "1" "2" "3" "4" ...
  .. ..$ : chr [1:5] "Cluster 1" "Cluster 2" "Cluster 3" "Cluster 4" ...
 $ x         : num [1:12288, 1:3] 0.824 0.814 0.82 0.787 0.792 ...
  ..- attr(*, "dimnames")=List of 2
  .. ..$ : chr [1:12288] "1" "2" "3" "4" ...
  .. ..$ : chr [1:3] "red" "green" "blue"
 $ cluster   : Named int [1:12288] 2 2 2 1 1 1 1 1 1 1 ...
  ..- attr(*, "names")= chr [1:12288] "1" "2" "3" "4" ...
 $ csize     : Named num [1:5] 2378 2062 2382 3032 2434
  ..- attr(*, "names")= chr [1:5] "1" "2" "3" "4" ...
 $ sumsqrs   :List of 4
  ..$ between.ss   : num 372
  ..$ within.ss    : Named num [1:5] 16.28 8.79 18.12 8.58 11.8
  .. ..- attr(*, "names")= chr [1:5] "1" "2" "3" "4" ...
  ..$ tot.within.ss: num 63.6
  ..$ tot.ss       : num 436
 $ k         : num 5
 $ m         : num 2
 $ iter      : num 107
 $ best.start: int 1
 $ func.val  : num 34.5
 $ comp.time : num 177
 $ inpargs   :List of 8
  ..$ iter.max: int 1000
  ..$ con.val : num 1e-09
  ..$ dmetric : chr "sqeuclidean"
  ..$ alginitv: chr "kmpp"
  ..$ alginitu: chr "imembrand"
  ..$ fixcent : logi FALSE
  ..$ fixmemb : logi FALSE
  ..$ stand   : logi FALSE
 $ algorithm : chr "FCM"
 $ call      : language ppclust::fcm(x = df, centers = 5)
 - attr(*, "class")= chr "ppclust"
LS0tCnRpdGxlOiAiRnV6enkgYy1tZWFucyBjbHVzdGVyaW5nIgpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sKLS0tClVubGlrZSBLLW1lYW5zIGFsZ29yaXRobSwgZWFjaCBkYXRhIG9iamVjdCBpcyBub3QgdGhlIG1lbWJlciBvZiBvbmx5IG9uZSBjbHVzdGVyIGJ1dCBpcyB0aGUgbWVtYmVyIG9mIGFsbCBjbHVzdGVycyB3aXRoIHZhcnlpbmcgZGVncmVlcyBvZiBtZW1iZXJoaXAgYmV0d2VlbiAwIGFuZCAxLgoKSW4gb3VyIGNhc2UgLCBlYWNoIGRhdGEgb2JqZWN0IGJlbG9uZyB0byBPTkxZIG9uZSBjZWxsdWxhciBjb21wb25lbnQgbnVjbGVhciwgY3l0b3BsYXNtIG9yIG1lbWJyYW5lLiAKCkNvbmNsdXNpb246IAoxIC0gZmNtIGFuZCBwZmNtIHRha2VzIGEgbG90IG9mIHRpbWUgaWYgd2UgdXNlIGhpZ2ggaW1hZ2UgcmVzb2x1dGlvbgoyIC0gay1tZWFucyBtZXRob2Qgc2VlbXMgdG8gYmUgbW9yZSBzdWl0YWJsZS4KCmBgYHtyIGluY2x1ZGU9RkFMU0V9CiNzb3VyY2UoImh0dHA6Ly9iaW9jb25kdWN0b3Iub3JnL2Jpb2NMaXRlLlIiKQojYmlvY0xpdGUoIkVCSW1hZ2UiKQpsaWJyYXJ5KCJFQkltYWdlIikKYGBgCgoKYGBge3J9CmltIDwtIHJlYWRJbWFnZSgiYmFzYWxlcy5qcGciKQpkaW0oaW0pCnBsb3QoaW0pICMgcmFzdGVyIG1ldGhvZCBtZWFucyB3aXRoaW4gUgoKIyMgIEkuIHJlZHVjZSB0aGUgc2l6ZSBvZiBpbWFnZSAKIyBzY2FsZSB0byBhIHNwZWNpZmljIHdpZHRoIGFuZCBoZWlnaHQKICAgI2ltcyA8LSByZXNpemUoaW0sIHcgPSAyMDAsIGggPSAxMDApCgojIElJLiBzY2FsZSBieSA1MCU7IHRoZSBoZWlnaHQgaXMgZGV0ZXJtaW5lZCBhdXRvbWF0aWNhbGx5IHNvIHRoYXQKIyB0aGUgYXNwZWN0IHJhdGlvIGlzIHByZXNlcnZlZAppbXMgPC0gcmVzaXplKGltLCBkaW0oaW0pWzFdLzgpCmltcwpwbG90KGltcykKYGBgCgpgYGB7cn0KIyByZXNoYXBlIGltYWdlIGludG8gYSBkYXRhIGZyYW1lCmRmID0gZGF0YS5mcmFtZSgKICByZWQgPSBtYXRyaXgoaW1zWywsMV0sIG5jb2w9MSksCiAgZ3JlZW4gPSBtYXRyaXgoaW1zWywsMl0sIG5jb2w9MSksCiAgYmx1ZSA9IG1hdHJpeChpbXNbLCwzXSwgbmNvbD0xKQopCnN0cihkZikKYGBgCgoKYGBge3IgaW5jbHVkZT1GQUxTRX0KbGlicmFyeShwcGNsdXN0KQpgYGAKCiMjIFVuc3VwZXJ2aXNlZCBQb3NzaWJpbGlzdGljIEZ1enp5IEMtTWVhbnMgYWxnb3JpdGhtCmBgYHtyfQojIFBvc3NpYmlsaXN0aWMgRnV6enkgQy1NZWFucyBDbHVzdGVyaW5nIEFsZ29yaXRobQojIyB0aGlzIHJ1biB0YWtlcyBhIGxvdCBvZiB0aW1lIGV2ZW4gSSByZWR1Y2UgdGhlIHNpemUgb2YgaW1hZ2UgYnkgNAojIHJlcy5wZmNtIDwtIHBwY2x1c3Q6OnBmY20oZGYsIGNlbnRlcnM9NSkKIyBhIG51bWVyaWMgbWF0cml4IGNvbnRhaW5pbmcgdGhlIGZpbmFsIGNsdXN0ZXIgcHJvdG90eXBlcy4KcmVzLnBmY20kdgojICAgICAgICAgICAgICAgICByZWQgICAgIGdyZWVuICAgICAgYmx1ZQojIENsdXN0ZXIgMSAwLjg0MjA2MTMgMC42MTkxNzMyIDAuNjk3NzQzNwojIENsdXN0ZXIgMiAwLjgxODI5MzQgMC40ODc2ODk4IDAuNTYxNzMzNwojIENsdXN0ZXIgMyAwLjg3MjA1NDkgMC43NjQ0NTAyIDAuNzc5NzMwMAojIENsdXN0ZXIgNCAwLjgzNTU5MDMgMC41MTk1NTE0IDAuNjAyOTgwNwojIENsdXN0ZXIgNSAwLjY5MjcyMzggMC40MjQwNTc0IDAuNTMzMDQ1NgpgYGAKCmBgYHtyfQojIGEgbnVtZXJpYyBtYXRyaXggY29udGFpbmluZyB0aGUgdHlwaWNhbGl0eSBkZWdyZWVzIG9mIHRoZSBkYXRhIG9iamVjdHMuCiMgaGVhZChyZXMucGZjbSR0KQojICAgQ2x1c3RlciAxICBDbHVzdGVyIDIgQ2x1c3RlciAzICBDbHVzdGVyIDQgIENsdXN0ZXIgNQojIDEgMC4xMjg4NDQ2IDAuMDI0MDEwMDAgMC41NDQzMjY5IDAuMDQyOTE5NjIgMC4wMjA1NTk3NwojIDIgMC4xMzcyNzA0IDAuMDI0NzUxMzggMC41MTYzNDQzIDAuMDQ0NDY5MjAgMC4wMjEzNDUyNAojIDMgMC4xNzc4MDI4IDAuMDI4ODgwNjcgMC42MTcwODk3IDAuMDUyOTE3MTQgMC4wMjM4ODAzOAojIDQgMC4yMzc5NzE1IDAuMDM0OTY2NTAgMC4zMzcwNTQ4IDAuMDY1MTg3MjkgMC4wMjkxOTQ0MQojIDUgMC4zMzYzNTIwIDAuMDQyNDQ4NDggMC4yODEwMzAwIDAuMDgxNjQ1MjEgMC4wMzM3MzYwMwojIDYgMC4yNzUzNjEyIDAuMDQ1NDE2MDMgMC4xNTI4Mjg1IDAuMDg0MjY2OTEgMC4wMzk2NTExMwpgYGAKCmBgYHtyfQojIGEgbnVtZXJpYyBtYXRyaXggY29udGFpbmluZyB0aGUgZGlzdGFuY2VzIG9mIG9iamVjdHMgdG8gdGhlIGZpbmFsIGNsdXN0ZXIgcHJvdG8tIHR5cGVzCiMgaGVhZChyZXMucGZjbSRkKQojICBDbHVzdGVyIDEgIENsdXN0ZXIgMiAgIENsdXN0ZXIgMyAgQ2x1c3RlciA0IENsdXN0ZXIgNQojIDEgMC4wNDE1ODYwMiAwLjE0OTQ4MTQxIDAuMDAzNzYxNTExIDAuMTEzNjY3MDEgMC4yMjQzMDI4CiMgMiAwLjAzODY1NTg5IDAuMTQ0ODkzODIgMC4wMDQyMDg4NzIgMC4xMDk1Mjg1MiAwLjIxNTg3NTUKIyAzIDAuMDI4NDQxNjggMC4xMjM2NTE0OSAwLjAwMjc4ODE1OSAwLjA5MTIyOTEzIDAuMTkyNDU4NAojIDQgMC4wMTk2OTUzOCAwLjEwMTQ5MDIyIDAuMDA4ODM3ODM3IDAuMDczMDk3NjggMC4xNTY1Njk3CiMgNSAwLjAxMjEzNTYxIDAuMDgyOTUzMzYgMC4wMTE0OTU0NzMgMC4wNTczMzUyNSAwLjEzNDg1ODAKIyA2IDAuMDE2MTg1OTAgMC4wNzcyOTI3OCAwLjAyNDkwNzgxNyAwLjA1NTM5Mjg1IDAuMTE0MDM3NwpgYGAKCgpgYGB7cn0KIyBhIG51bWVyaWMgdmVjdG9yIGNvbnRhaW5pbmcgdGhlIGNsdXN0ZXIgbGFiZWxzIGZvdW5kIGJ5IGRlZnV6emlmeWluZyB0aGUgdHlwaWNhbGl0eSBkZWdyZWVzIG9mIHRoZSBvYmplY3RzLgpyZXMucGZjbSRjbHVzdGVyWzE6MjBdCiMgMSAgMiAgMyAgNCAgNSAgNiAgNyAgOCAgOSAxMCAxMSAxMiAxMyAxNCAxNSAxNiAxNyAxOCAxOSAyMCAKIyAzICAzICAzICAzICAxICAxICAxICAxICAzICAxICAxICA0ICA0ICA0ICA0ICA0ICAyICAyICA1ICA1IAojdW5pcXVlKHJlcy5wZmNtJGNsdXN0ZXIpCiNbMV0gMyAxIDQgMiA1CmBgYAoKCmBgYHtyfQojIGEgbnVtZXJpYyB2ZWN0b3IgZm9yIHRoZSBudW1iZXIgb2Ygb2JqZWN0cyBpbiB0aGUgY2x1c3RlcnMuCiMgcmVzLnBmY20kY3NpemUKIyAgIDEgICAgMiAgICAzICAgIDQgICAgNSAKIyAyODkyIDIwMjggMjYxMCAyMTc0IDI1ODQKYGBgCgoKYGBge3J9CmRmJGxhYmVsID0gcmVzLnBmY20kY2x1c3RlcgogIAogICMjIyBSZXBsYWNlIHRoZSBjb2xvciBvZiBlYWNoIHBpeGVsIGluIHRoZSBpbWFnZSB3aXRoIHRoZSBtZWFuIAogICMjIyBSLEcsIGFuZCBCIHZhbHVlcyBvZiB0aGUgY2x1c3RlciBpbiB3aGljaCB0aGUgcGl4ZWwgcmVzaWRlczoKICAKICAjIGdldCB0aGUgY29sb3JpbmcKICBjb2xvcnMgPSBkYXRhLmZyYW1lKAogICAgbGFiZWwgPSAxOm5yb3coSyRjZW50ZXJzKSwgCiAgICBSID0gcmVzLnBmY20kdlssInJlZCJdLAogICAgRyA9IHJlcy5wZmNtJHZbLCJncmVlbiJdLAogICAgQiA9IHJlcy5wZmNtJHZbLCJibHVlIl0KICApCiAgCiAgIyBtZXJnZSBjb2xvciBjb2RlcyBvbiB0byBkZgogICMgSU1QT1JUQU5UOiB3ZSBtdXN0IG1haW50YWluIHRoZSBvcmlnaW5hbCBvcmRlciBvZiB0aGUgZGYgYWZ0ZXIgdGhlIG1lcmdlIQogIAogIGRmJG9yZGVyIDwtIDE6bnJvdyhkZikKICBkZiA8LSBtZXJnZShkZiwgY29sb3JzKQogIAogIAogICMgcmVvcmRlciB0aGUgbWF0cml4IChpbWFnZSkKICAgIGRmIDwtIGRmW29yZGVyKGRmJG9yZGVyKSxdCiAgICBkZiRvcmRlciA9IE5VTEwKICAgIAogICAgIyBnZXQgbWVhbiBjb2xvciBjaGFubmVsIHZhbHVlcyBmb3IgZWFjaCByb3cgb2YgdGhlIGRmLgogICAgUiA8LSBtYXRyaXgoZGYkUiwgbnJvdz1kaW0oaW1zKVsxXSkKICAgIEcgPC0gbWF0cml4KGRmJEcsIG5yb3c9ZGltKGltcylbMV0pCiAgICBCIDwtIG1hdHJpeChkZiRCLCBucm93PWRpbShpbXMpWzFdKQogICAgCiAgICAjIHJlY29uc3RpdHV0ZSB0aGUgc2VnbWVudGVkIGltYWdlIGluIHRoZSBzYW1lIHNoYXBlIGFzIHRoZSBpbnB1dCBpbWFnZQogICAgaW0uc2VnbWVudGVkIDwtIGFycmF5KGRpbT1kaW0oaW1zKSkKICAgIGltLnNlZ21lbnRlZFssLDFdID0gUgogICAgaW0uc2VnbWVudGVkWywsMl0gPSBHCiAgICBpbS5zZWdtZW50ZWRbLCwzXSA9IEIKICAgIAogICAgaW0uc2VnbWVudGVkIDwtIEVCSW1hZ2U6OkltYWdlKGltLnNlZ21lbnRlZCwgY29sb3Jtb2RlPUNvbG9yKQogICAgCiAgICBwbG90KGltLnNlZ21lbnRlZCkKYGBgCgoKCgojIFBhcnRpdGlvbmluZyBDbHVzdGVyIEFuYWx5c2lzIFVzaW5nIEZ1enp5IEMtTWVhbnMKCmBgYHtyfQppbSA8LSByZWFkSW1hZ2UoImJhc2FsZXMuanBnIikKZGltKGltKQojIElJLiBzY2FsZSBieSA1MCU7IHRoZSBoZWlnaHQgaXMgZGV0ZXJtaW5lZCBhdXRvbWF0aWNhbGx5IHNvIHRoYXQKIyB0aGUgYXNwZWN0IHJhdGlvIGlzIHByZXNlcnZlZAppbXMgPC0gcmVzaXplKGltLCBkaW0oaW0pWzFdLzgpCnBsb3QoaW1zKQpgYGAKCmBgYHtyfQojIHJlc2hhcGUgaW1hZ2UgaW50byBhIGRhdGEgZnJhbWUKZGYgPSBkYXRhLmZyYW1lKAogIHJlZCA9IG1hdHJpeChpbXNbLCwxXSwgbmNvbD0xKSwKICBncmVlbiA9IG1hdHJpeChpbXNbLCwyXSwgbmNvbD0xKSwKICBibHVlID0gbWF0cml4KGltc1ssLDNdLCBuY29sPTEpCikKYGBgCgpgYGB7cn0KcmVzLmZjbSA8LSBwcGNsdXN0OjpmY20oZGYsIGNlbnRlcnMgPSA1KQpzdHIocmVzLmZjbSkKYGBgCgo=